home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
UCB Logo 3.0
/
CSLS
/
playfair
< prev
next >
Wrap
Text File
|
1992-09-04
|
2KB
|
101 lines
TO BIGWORD :LIST
IF EMPTYP :LIST [OUTPUT "]
OUTPUT WORD FIRST :LIST BIGWORD BF :LIST
END
TO ENCODE :MESSAGE
IF EMPTYP :MESSAGE [OUTPUT "]
IF EMPTYP BF :MESSAGE [OUTPUT PAIRCODE FIRST :MESSAGE "Q]
IF EQUALP (JTOI FIRST :MESSAGE) (JTOI FIRST BF :MESSAGE) ~
[OUTPUT WORD (PAIRCODE FIRST :MESSAGE "Q) (ENCODE BF :MESSAGE)]
OUTPUT WORD (PAIRCODE FIRST :MESSAGE FIRST BF :MESSAGE) ~
(ENCODE BF BF :MESSAGE)
END
TO ITOJ :LETTER
IF EQUALP :LETTER "I [IF EQUALP RANDOM 3 0 [OUTPUT "J]]
OUTPUT :LETTER
END
TO JTOI :WORD
IF EMPTYP :WORD [OUTPUT "]
IF EQUALP FIRST :WORD "J [OUTPUT WORD "I JTOI BF :WORD]
OUTPUT WORD FIRST :WORD JTOI BF :WORD
END
TO LETTER :COORDS
OUTPUT ITOJ ITEM LAST :COORDS (ITEM FIRST :COORDS :MATRIX)
END
TO LETTERS :ONE :TWO
OUTPUT WORD LETTER :ONE LETTER :TWO
END
TO PAIRCODE :ONE :TWO
OUTPUT PAIRCODE1 (THING :ONE) (THING :TWO)
END
TO PAIRCODE1 :ONE :TWO
LOCAL [A B C D]
MAKE "A FIRST :ONE
MAKE "B LAST :ONE
MAKE "C FIRST :TWO
MAKE "D LAST :TWO
IF EQUALP :A :C ~
[OUTPUT LETTERS (LIST :A ROTATE (:B+1)) ~
(LIST :A ROTATE (:D+1))]
IF EQUALP :B :D ~
[OUTPUT LETTERS (LIST ROTATE (:A+1) :B) ~
(LIST ROTATE (:C+1) :B)]
OUTPUT LETTERS (LIST :A :D) (LIST :C :B)
END
TO PLAYFAIR :KEYWORD :MESSAGE
SETKEYWORD JTOI :KEYWORD
OUTPUT ENCODE BIGWORD :MESSAGE
END
TO REMOVE :LETTERS :STRING
IF EMPTYP :STRING [OUTPUT "]
IF MEMBERP FIRST :STRING :LETTERS [OUTPUT REMOVE :LETTERS BF :STRING]
OUTPUT WORD FIRST :STRING REMOVE :LETTERS BF :STRING
END
TO REORDER :STRING
OUTPUT REORDER1 :STRING [] [] 5
END
TO REORDER1 :STRING :ALL :ROW :COUNT
IF EQUALP :COUNT 0 [OUTPUT REORDER1 :STRING (LPUT :ROW :ALL) [] 5]
IF EMPTYP :STRING [OUTPUT :ALL]
OUTPUT REORDER1 (BF :STRING) :ALL (LPUT FIRST :STRING :ROW) ~
(:COUNT-1)
END
TO ROTATE :INDEX
OUTPUT IFELSE EQUALP :INDEX 6 [1] [:INDEX]
END
TO SETKEYWORD :WORD
MAKE "MATRIX REORDER WORD :WORD REMOVE :WORD "ABCDEFGHIKLMNOPQRSTUVWXYZ
SETLETTERS :MATRIX
MAKE "J :I
END
TO SETLETTERS :MATRIX
SETLETTERS1 :MATRIX 1
END
TO SETLETTERS1 :MATRIX :ROW
IF EMPTYP :MATRIX [STOP]
SETLETTERS2 (FIRST :MATRIX) :ROW 1
SETLETTERS1 (BF :MATRIX) (:ROW+1)
END
TO SETLETTERS2 :LIST :ROW :COL
IF EMPTYP :LIST [STOP]
MAKE FIRST :LIST LIST :ROW :COL
SETLETTERS2 (BF :LIST) :ROW (:COL+1)
END